Rem Project: Text3D
Rem Created: 12/04/2005 23:51:59

Rem ***** Main Source File *****
set display mode 1024,768,32:Set Window Layout 0,0,1:sync on:autocam off:backdrop on:color backdrop rgb(10,10,10)

`Initialise the D3Dfunc dll
D3D_Init

set text font "Arial"
set text size 15
D3D_Font 2,"Arial",15,0,0,1
do
D3D_Color 255,255,255,255

text 0,0,"D3D Extras dll - Demonstation"
text 0,15,"(1) Antialiased text vs Normal text"
text 0,30,"(2) Antialiased text vs Normal text using multiple fonts"
text 0,45,"(3) 3D Text"
text 0,60,"(4) 3D Line Drawing"
text 0,75,"(5) Pyramid Creation"
text 0,90,"(ESC) Quit Demo"

text 0,105,"Press a key to select a demo"

text 0,750,"Written By Jason Clogg (2005)"
D3D_StartText
   D3D_Text 2,512,200,1,"Example of AA text alignment"

   D3D_Color 0,0,200,220
   Width=D3D_GetTextWidth (2,"0=Left Aligned")
   Height=D3D_GetTextHeight (2,"0=Left Aligned")
   D3D_box 512,240,512+Width,240+Height,1
   D3D_Color 255,255,255,255
   D3D_Text 2,512,240,0,"0=Left Aligned"

   D3D_Color 0,0,200,220
   Width=D3D_GetTextWidth (2,"1=Centered")
   Height=D3D_GetTextHeight (2,"1=Centered")
   D3D_box 512-(Width/2),280,512+(Width/2),280+(Height),1
   D3D_Color 255,255,255,255
   D3D_Text 2,512,280,1,"1=Centered"

   D3D_Color 0,0,200,220
   Width=D3D_GetTextWidth (2,"2=Right Aligned")
   Height=D3D_GetTextHeight (2,"2=Right Aligned")
   D3D_box 512-Width,320,512,320+(Height),1
   D3D_Color 255,255,255,255
   D3D_Text 2,512,320,2,"2=Right Aligned"

   D3D_Color 0,0,200,220
   D3D_Box 412,400,612,600
   D3D_Color 255,255,255,255
   D3D_line 412,400,612,400
   D3D_line 612,400,612,600
   D3D_line 612,600,412,600
   D3D_line 412,600,412,400
   DisplayText$="This is text displayed by D3D_BoxText." +chr$(10)+chr$(10)
   DisplayText$=DisplayText$+"It enables you to display text within a defined boundary."
   d3d_BoxText 2,412,400,200,200,1,1,DisplayText$
D3D_EndText

   line 512,230,512,350


if inkey$()="1" then gosub AntiVsText
if inkey$()="2" then gosub AntiVsTextMulti
if inkey$()="3" then gosub TextMesh
if inkey$()="4" then gosub 3DLineDraw
if inkey$()="5" then gosub PyramidCreation
`if upper$(inkey$())="Q" then end

sync

loop

AntiVsText:

Rem D3D_Font for Antialiased Text and 3D Text commands - Format is Font number Font Name,size,bold(0 or 1),italic(0 or 1)
D3D_Font 1,"Arial",9,0,0,1
D3D_Font 2,"Arial",15,0,0,1
set text font "Arial"
set text size 15
textmode=1

do
if textmode=1
   text 0,0,"Normal Text Text - FPS="+str$(screen fps())
   text 0,15,"Press space to toggle test, 'q' to quit to menu"
   for i=1 to 200
      text rnd(1000),rnd(600)+50,"Test Text String"
   next i
else
  D3D_StartText
   D3D_Text 1,0,0,0,"Antialiased Text Text - FPS="+str$(screen fps())
   D3D_Text 1,0,15,0,"Press space to toggle test, 'q' to quit to menu,'i' toggle information"
   if showinfo=1
      D3D_Text 1,0,45,0,"To use the dll text commands you should do the following :-"
      D3D_Text 1,0,75,0,"Set the font to use"
      D3D_Text 1,0,105,0,"Set the draw colour"
      D3D_Text 1,0,135,0,"Start text drawing mode"
      D3D_Text 1,0,165,0,"draw the text"
      D3D_Text 1,0,195,0,"End text drawing mode"
      D3D_Color 255,0,0,255
      D3D_Text 1,150,75,0,"D3D_Font "+chr$(34)+"Arial"+chr$(34)+",9,0,0"
      D3D_Text 1,150,105,0,"D3D_Color 255,255,255,255"
      D3D_Text 1,150,135,0,"D3D_StartText"
      D3D_Text 1,150,165,0,"D3D_Text 1,0,0,0,"+chr$(34)+"Hello World"+chr$(34)
      D3D_Text 1,150,195,0,"D3D_EndText"
      D3D_Color 100,100,100,100
      D3D_Text 1,150,90,0,"D3D_Font FontName$,height in pixels,bold(0-no,1-yes),italic(0-no,1-yes)"

      D3D_Text 1,150,120,0,"D3D_Color Red(0-255),Green(0-255),Blue(0-255),Alpha(0-255)"
      D3D_Text 1,150,180,0,"D3D_Text font number,x,y,alignment,text$"

      D3D_Color 255,255,255,255

      D3D_Text 1,0,225,0,"Always set your fonts up outside the main loop."
      D3D_Text 1,0,240,0,"There can be multiple 'StartText' 'EndText' pairs"
      D3D_Text 1,0,255,0,"in a loop but there must not be any image or sprite"
      D3D_Text 1,0,270,0,"display commands between 'StartText' and 'EndText'."
      D3D_Text 1,0,285,0,"The more of these pairs in your loop the slower it gets!"
      xrnd=500:xmin=500
   else
      D3D_Color 255,255,255,255
      xrnd=1000:xmin=0
   endif

    for i=1 to 200
      D3D_Text 2,rnd(xrnd)+xmin,rnd(600)+50,0,"Test Text String"
   next i

   D3D_EndText
endif
rem Perform Text drawing to screen D3D_EndText dummyval. Not sure how to set up function
rem with no parameters or return code
if spacekey()=1
   if spacepressed=0
      spacepressed=1
      if textmode=1 then textmode=0 else textmode=1
   endif
else
   spacepressed=0
endif

if upper$(inkey$())="I"
   if Ipressed=0
      Ipressed=1
      if showinfo=1 then showinfo=0 else showinfo=1
   endif
else
   Ipressed=0
endif

if upper$(inkey$())="Q"
   set text font "Arial"
   set text size 15
   ink rgb(255,255,255),0
   return
endif

sync

loop

return

AntiVsTextMulti:

D3D_Font 1,"Arial",9,0,0,1
D3D_Font 2,"Tahoma",15,0,0,1
D3D_Font 3,"Comic Sans MS",25,0,0,1
D3D_Color 255,0,0,255

ink rgb(255,0,0),0
textmode=1

do
if textmode=1
   set text font "Arial"
   set text size 15
   text 0,0,"Normal Text Text - FPS="+str$(screen fps())
   text 0,15,"Press space to toggle test, 'q' to quit to menu"
   for i=1 to 5
      set text font "Tahoma"
      set text size 25
      text rnd(1000),rnd(600)+50,"Test Text String"
      set text font "Comic Sans MS"
      set text size 42
      text rnd(1000),rnd(600)+50,"Test Text String"
   next i
else
   D3D_StartText
   D3D_Text 1,0,0,0,"Antialiased Text Text - FPS="+str$(screen fps())
   D3D_Text 1,0,15,0,"Press space to toggle test, 'q' to quit to menu"
   for i=1 to 200
      D3D_Text 2,rnd(1000),rnd(600)+50,0,"Test Text String"
      D3D_Text 3,rnd(1000),rnd(600)+50,0,"Test Text String"
   next i
   D3D_EndText
endif

if spacekey()=1
   if spacepressed=0
      spacepressed=1
      if textmode=1 then textmode=0 else textmode=1
   endif
else
   spacepressed=0
endif

if upper$(inkey$())="Q"
   set text font "Arial"
   set text size 15
   ink rgb(255,255,255),0
   d3d_color 255,255,255,255
   return
endif

sync

loop

return
TextMesh:

cls
color backdrop rgb(10,10,10)
set camera view 0,0,512,384
make camera 1
color backdrop 1,rgb(40,0,0)
set camera view 1,512,0,1024,384
make camera 2
color backdrop 2,rgb(0,40,0)
set camera view 2,0,384,512,768
make camera 3
color backdrop 3,rgb(0,0,40)
set camera view 3,512,385,1024,768

do
   text$=InputText(0,0,"Enter text to be converted to a mesh : ","Text3D")
   font$=InputText(0,0,"Enter font to use : ","Arial")
   depth#=val(InputText(0,0,"Enter object depth : ",".1"))
   quality=val(InputText(0,0,"Enter object quality(0-low,1-medium,2-high) : ","2"))
   alignment=val(InputText(0,0,"Enter mesh alignment(0-left,1-center,2-right,3-font origin : ","1"))
   D3D_Font 1,font$,15,0,0,1
   D3D_Make_3DText 1, 1,text$,depth#,quality,alignment

   position object 1,0,0,0
   color object 1,rgb(255,0,0)
   ca#=0
   while spacekey()=0
      text 0,0,"3D Text Demonstration - FPS="+str$(screen fps())+" - polygons="+str$(statistic(1))
      text 0,15,"Press Space to create another object"
      text 0,30,"Press 'q' to quit to menu"

      cx#=cos(ca#)*5
      cz#=sin(ca#)*5
      position camera cx#,2,cz#
      point camera 0,0,0
      position camera 1,cx#*.5,2,cz#*.5
      point camera 1,0,0,0
      position camera 2,cx#*.75,-2,cz#*.75
      point camera 2,0,0,0
      position camera 3,cx#*1.25,3,cz#*1.25
      point camera 3,0,0,0
      ca#=ca#+.1

      if upper$(inkey$())="Q"
         set text font "Arial"
         set text size 15
         ink rgb(255,255,255),0
         delete object 1
         delete camera 1
         delete camera 2
         delete camera 3
         set camera view 0,0,1024,768
         return
      endif

      sync

   endwhile
   delete object 1
loop
return
3DLineDraw:
cls
ca#=0
for i=1 to 20
   if object exist(i+100)=0 then  make object sphere i+100,.5
   hide object i+100
next i
zpos#=50
x=0
y=0
set text opaque
color backdrop rgb(10,10,10)
set camera view 0,0,512,384
make camera 1
color backdrop 1,rgb(40,0,0)
set camera view 1,512,0,1024,384
make camera 2
color backdrop 2,rgb(0,40,0)
set camera view 2,0,384,512,768
make camera 3
color backdrop 3,rgb(0,0,40)
set camera view 3,512,385,1024,768
do
   text 0,0,"3D Line Demonstration - FPS="+str$(screen fps())
   text 0,15,"Press 'q' to quit to menu"

   cx#=cos(ca#)*zpos#
   cz#=sin(ca#)*zpos#
   position camera cx#,2,cz#
   point camera 0,0,0
   position camera 1, cx#,2,cz#
   point camera 1,0,0,0
   position camera 2, cx#,2,cz#
   point camera 2,0,0,0
   position camera 3, cx#,2,cz#
   point camera 3,0,0,0
   ca#=ca#+.1

   randomize 0

   x1#=rnd(20)-5
   y1#=rnd(20)-5
   z1#=rnd(20)-5

   for i=1 to 20
      x2#=rnd(20)-5
      y2#=rnd(20)-5
      z2#=rnd(20)-5
      position object i+100,x1#,y1#,z1#
      show object i+100
      LineColor=D3D_RGBA(rnd(255),rnd(255),rnd(255),255)
      D3D_Line3D x1#,y1#,z1#,x2#,y2#,z2#,LineColor,LineColor, 0
      D3D_Line3D 1,x1#,y1#,z1#,x2#,y2#,z2#,LineColor,LineColor, 0
      D3D_Line3D 2,x1#,y1#,z1#,x2#,y2#,z2#,LineColor,LineColor, 0
      D3D_Line3D 3,x1#,y1#,z1#,x2#,y2#,z2#,LineColor,LineColor, 0
      D3D_Dot3D x1#,y1#,z1#,5,LineColor, 0
      D3D_Dot3D 1,x1#,y1#,z1#,5,LineColor, 0
      D3D_Dot3D 2,x1#,y1#,z1#,5,LineColor, 0
      D3D_Dot3D 3,x1#,y1#,z1#,5,LineColor, 0
      x1#=x2#
      y1#=y2#
      z1#=z2#
   next i

   if zpos#=>50 then zmove#=-.01
   if zpos#=<-50 then zmove#=.01
   zpos#=zpos#+zmove#

   if upper$(inkey$())="Q"
      for i=1 to 20
         hide object i+100
      next i
      set camera view 0,0,screen width(),screen height()
      cls 0
      set text font "Arial"
      set text size 15
      ink rgb(255,255,255),0
      delete object 1
      delete camera 1
      delete camera 2
      delete camera 3
      set camera view 0,0,1024,768
      return
   endif
   sync
loop
return

function InputText(x,y,Message$,default$)

text$=default$
clear entry buffer
do
text x,y,Message$+text$
buf$=entry$():clear entry buffer
for i=1 to len(buf$)
   select asc(mid$(buf$,i))
      case 8
         text$=left$(text$,len(text$)-1)
      endcase
      case 13
         exitfunction text$
      endcase
      case default
         text$=text$+mid$(buf$,i)
      endcase
   endselect
next i
sync

loop
endfunction ""

PyramidCreation:
cls

Do
  D3D_Make_Pyramid 1, 1 + Rnd(4), 1 + Rnd(4), 1 + Rnd(4)

  While SpaceKey() = 0
    text 0,0,"Pyramid Demonstration - FPS="+str$(screen fps())+" - polygons="+str$(statistic(1))
    text 0,15,"Press Space to create another object"
    text 0,30,"Press 'q' to quit to menu"

    cx#=cos(ca#)*5
    cz#=sin(ca#)*5
    position camera cx#,2,cz#
    point camera 0,0,0
    ca#=ca#+.1

    if upper$(inkey$())="Q"
       set text font "Arial"
       set text size 15
       ink rgb(255,255,255),0
       delete object 1
       return
    endif

    sync
  EndWhile

  Delete Object 1
Loop
return